perm filename PRESCN.F4[MSS,LCS] blob sn#133830 filedate 1974-12-04 generic text, type T, neo UTF8
00100		SUBROUTINE PRESCN
00200	C  THIS SORTS OUT NEW INPUT FORMAT - CREATES OLD STYLE.
00300		DIMENSION IR(1)
00400		COMMON/ALF/INP(72),M/XRN/RN(4000)
00500		EQUIVALENCE (IR,RN(2001))
00600	C  CHECK THIS EQUIV.↑↑↑↑
00605	100	IF(ISM)5,55,555
00607	C  -1=PROCESS SOME MORE, 0=1ST TIME, 1=PUT OUT RHYTH
00610	55	JX=0
00900	5	K=0
01000		J=0
01100		I=JX
01150		JX=JX+72
01200	1	K=K+1
01400		M=INP(K)
01410	15	IF(M.EQ.' '.OR.M.EQ.',')GO TO 1
01420	C  REMOVE BLANKS AND COMMAS
01490		JN=0
01500		IF(M.GE.'0'.AND.M.LE.'9')GO TO 2
01600		MM=INP(K+1)
01700	3	IF((M.GE.'A'.AND.M.LE.'G'.AND.MM.NE.'L'.AND.MM.NE.'A').OR.
01800		1 M.EQ.'P'.OR.M.EQ.'O')GO TO 8
01900	C  FINDS NOTES, PROX., AND ORDINARY, -- NOT 'BA' OR 'AL'
02000		IF(M.NE.'R')GO TO 9
02100		IF(MM.EQ.'E')JN=1
02200	C  CATCHES 'R' 'RI' 'REP'
02400		GO TO 8
02440	9	IF(M.EQ.'/'.OR.M.EQ.';'.OR.M.EQ.'*'.OR.M.EQ.':')GO TO 8
02500		JN=-1
02600	8	J=J+1
02700		 INP(J)=M
02760		IF(M.EQ.'X')JN=1
02780	C  PICKS UP 4X ETC. FOR BOTH NOTES AND RHYTH.
02800		IF(JN.LE.0)GO TO 13
02900	C  PUTS 'REP' INTO RHYTH ALSO
02910		I=I+1
02920		IR(I)=M
03100	13	IF(M.EQ.'/'.OR.M.EQ.';'.OR.M.EQ.'*')GO TO 4
03200		K=K+1
03300		M=INP(K)
03400		GO TO 8
03500	
03600	4	IF(JN.NE.0)GO TO 7
03700		I=I+1
03800		IR(I)=M
03900	7	IF(M.EQ.'/')GO TO 1
04000		IF(M.EQ.';')GO TO 11
04100		IF(M.EQ.'*')GO TO 6
04200	
04300	2	I=I+1
04400		IR(I)=M
04500		K=K+1
04600		M=INP(K)
04710		IF(M.EQ.'.'.OR.(M.GE.'0'.AND.M.LE.'9'))GO TO 2
04715	C  NO BLANK NEEDED AFTER RHYTH.( /4.AS3/8/ ETC.)
04720		GO TO 15
04900	
05000	11	IF(IR(I).NE.';')IR(I)=';'
05100		ISM=-1
05120		RETURN
05140	C  WE'LL COME BACK FOR MORE.
05160	
05300	6	IF(IR(I).NE.'*')IR(I)='*'
05800		JX=0
05900		ISM=1
06000	C AFTER THIS WE USE RHYTJ DATA.
06100		RETURN
06200	
06300	555	DO 12 K=1,72
06400		M=IR(K+JX)
06500		INP(K)=M
06510		IF(M.EQ.';')GO TO 10
06520	C  MORE THAN ONE LINE
06530	12	IF(M.EQ.'*')GO TO 14
06540	10	JX=JX+72
06550	C  MOVE TO THE NEXT 'LINE'
06560		RETURN
06570	14	ISM=0
06600		END